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ie COPYRIGHT (c) 1978, 1980, 1982, 1984 BY 
ie DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. 
is ALL RIGHTS RESERVED. 


is THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED 
'* ONLY IN A DANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE 


: N SOFTWARE 0 Y OTHE 
:* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY 
!® QTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY 


*® 
® 
® 
w 
® 
® 
® 
® 
® 
® 
ie TRANSFERRED. * 
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i THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE 
> Camponnt itn. NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 


t* DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
!* SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 
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2 002 

3 003 '4+ 

; i FACILITY: FORTRAN Support Library, user callable 
3 003 ' ABSTRACT: 

3 0034 ! 

3 0035 ! Contains routines FORSDEF FILE W and FORSDEF_FILE, 

3 0036 ' implementing the FORTRAN DEFINE FILE statement with 

H sit f4 word-length and longword-length associate variable arguments. 
2 s't44 ENVIRONMENT: Mixture of AST Level or not. 

: sg AUTHOR: Jonathan M. Taylor, CREATION DATE: 4-OCT-77 

4 004 ' MODIFIED BY: 

4 0044 ! 

4 0045 : Jonathan he Taylor, 4-OCT-77 : VERSION 0 

4 0046 ! 0-1 = origina 

4 0047 ! 0-5 - Fix MAXREC and RECORDSIZE 4 : JMT 19-OCT-77 
4 0048 ! 0- - att FORSSCB_POP not _RET 9-0CT-77 
4 0049 !Q-4 = Use FORSK abcmnosyz as ELTERNAL PTPERALS. TNH 27-Oct-77 

5 0050 ! 0-5 = remove MARREC checking here. JMT eget eb-78 

5 0051 ! 0-9 = RECORDSIZE max is 64K Me at's 2e=Feb- 8 

5 4 ' 0-10 = Global register CCB. T 8-Apr-78 

5 005 ' Q-11 - change REQUIRE files tor. van $s ates build. DGP 28-Apr-78 
5 0054 ! B16 - Use JSB Ran ae TNH 2 are 

5 0055 ' 0-15 = Pass OPENSK_LUN_MIN to forse B PUSH. TNH c2-May-78 

5 0056 i 0-14 = Change file~name to FORDEFINE.B32, and chan e the names of 
5 0057 1 | the REQUIRE files similarly. JBS 14-NOV-7 
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1teecancs FPBRC FRE ts CBis. 205 IESNBUSEc=7e | 
CSP 


: - rsion 

1- Change BpEN fe to LUB. JBS 13-DEC 35 | 

i Change FORSK RE EERR to’ FORSK_INCRECTYP. JBS 24-SEP-1979 

0063 1 
0064 1 
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: 138 1065 1 EXTERNAL ROUTINE | 
s 7 1 1 RSSERR_ENDHND, ' error condition handler for ERR=, END= 
; 125 1 1 FOR IGRAL_STO : NOVALUE, ! convert error number and signal 

3; 1 $ 1068 1 CORsete _PUSA : J$B.CB_PUSH aes ; create LUB/ISB/RAB, if needed 

; ! 4 1969 } ORS$CB_POP : JSB_CB_POP NOVALUE; ' return I/0 system to previous state 

: 129 1or) 1 | 
3 : , 1oi8 ! PSECT DECLARATIONS: 
: 132 1074 1 DECLARE_PSECTS (FOR); ! declare PSECTS for FORS facility | 
; JSS 1075 1 
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GLOBAL ROUTINE FORSDEF_FILE_W (UNIT, MAX_REC, REC_SIZ, ASS_VAR) 
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IERIE MBAth tat i 


ae 
FUNCTIONAL DESCRIPTION: 


Call mg routine to eres DEFINE FILE for one-word 
associated variable. The argument List is passed in toto. 


FORMAL PARAMETERS: 


UNIT. rl.v Logical unit number 
MAX_REC.rl.v Maximum record number 
l.v Record buffer size 


Address of associated variable 
IMPLICIT INPUTS: 

See description of COMMON_DEF_FILE 
IMPLICIT OUTPUTS: 

See description of COMMON_DEF_FILE 


ROUTINE VALUE: 
COMPLETION CODES: 


NONE 
SIDE EFFECTS: 
See description of COMMON_DEF_FILE 


BEGIN 
BUILTIN 
AP; 


COMMON_DEF_FILE (.AP, 0); 
END; 


-TITLE FORSDEFINE_FILE 
-IDENT \1-004\ 

-EXTRN FORSSERR_ ENDHND 
-EXTRN FORSSSIGRA 
«-EXTRN FO 


-PSECT _FORSCODE,NOWRT, 


0000 90000 ENTRY FORSDEF_FILE_W, Save nothing 
ZE D4 00002 CLRL = = (SP) 
5C DD 0000 PUSHL AP 
0000v CF 02 FB 00006 CALLS #2, COMMON_DEF_FILE 
04 00008 RET 


$736 i ite es 
FORRTL.SRCJFORDEF INE.B352;1 


: NOVALUE = 


Be Se Re Be Oe Oe Se Oe Be Oe Oe Oe Bee OH SH Se BH ee Bees 


L_STO 
R$$CB_PUSA, FORSSCB_POP 


fORRDEFINE,FILE RkSort9ge 00:16:28 YAMCHT aLisgcaz v4igersg, | Pane 


; Routine Size: 12 bytes, Routine Base: _FORSCODE + 0000 


176 1117: «1 


; Routine Size: 12 bytes, Routine Base: _FORSCODE + 000C 


15 

FORSDEF INE_FILE 1-Se 1984 00:16:2 AX=-11 Bliss-32 V4.0-74 Page 7 

1-004 132800-1 3k 9955934 PORRTL  SRETFORDE INE B92: 1 . (4) 
; 178 1118 ! GLOBAL ROUTINE FORSDEF_FILE (UNIT, MAX_REC, REC_SIZ, ASS_VAR) : NOVALUE = ; 
; 180 1120 1 !+4 ‘ 
3 131 1 1 } } FUNCTIONAL DESCRIPTION: : 
3 183 11 § 1 7 Call Common routine to erie DEFINE FILE for longword : 
; He: 1} ¢ : associated variable. The argument List is passed in toto. ‘ 
: «186 1158 1 ! FORMAL PARAMETERS: ; 
; «187 11 1! ‘ 
; «(188 1128 1! UNIT. rl.v Logical unit number ° 
> «189 118? 1 ! MAX_REC.rl.v Maximum record number ‘ 
3; 199 1130 1! REC_SIZ.rl.v Record buffer size ° 
a. 1131 1! ASS_VAR Address of associated variable ‘ 
; 136 1136 1! ‘ 
3; 1133. 1 =! IMPLICIT INPUTS: ° 
: 194 1134 1! ° 
> 195 1135 1! See description of COMMON_DEF_FILE ‘ 
; 198 1136 1! : 
3 6197 1137 1°! IMPLICIT OUTPUTS: ° 
; 198 1138 1! ° 
; 199 1139 1! See description of COMMON_DEF_FILE , | : 
; 200 1140 1! ° 
$ ol 1141 1 ! ROUTINE VALUE: ° 
; 202 1108 1 ! COMPLETION CODES: ° 
; 203 1143 1! ‘ 
; 204 1144 1: NONE : 
; 205 1145 1: : 
; 206 1146 1 ! SIDE EFFECTS: ° 
; 207 1147 1/3 | : 
; 208 1148 1! See description of COMMON_DEF_FILE ‘ 
: 209 1149 1! ° 
: 210 1150 | !e- ° 
3s ¢ti 1151 1 ‘ 
: sig 1136 2 BEGIN | ‘ 
3; 21 1153 2 ; 
; 214 1154 2 BUILTIN ; 
+ 215 1155 2 AP; | : 
3; 206 1156 2 ; 
s ea 1157 2 COMMON_DEF_FILE (.AP, 1); ¢ 
; 218 1158 1 END; ‘ 
0000 00000 -ENTRY FORSDEF_FILE, Save nothing ; 1118 | : 
91 0 00002 PUSHL #1 : 1157 | 
C DD 00004 PUSHL AP 3 : 
0000v CF 02 FB 00006 CALLS #2, COMMON_DEF _FILE ; ‘ 
04 00008 RET : : 


s 219 1159 1 | 
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FORSDEF INE_FILE 16-Sep-1986 00:16:2 AX=11 Bliss-32 V4.0-74 ° 
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E 


1 = longword | 
i IMPLICIT INPUTS: | 
LUB$V_DIRECT This unit as previously been specified 


$ ROUTINE COMMON_DEF_FILE (OLD_AP, FLAG) : NOVALUE = 

6 14+ 

? } FUNCTIONAL DESCRIPTION: 

6 i Get a LUB for this unit and set some LUB entries according 

? to values passed to our caller. 

6 i FORMAL PARAMETERS: 

5 OLD_AP Address of the arg List that was passed 
7 to our caller 
7 FLAG Length of users associated variable: | 
7 - word 

7 

7 

7 

7 

7 

7 

8 


for direct access by an OPEN statement or 
DEFINE FILE. 
LUBSV_OPENED This unit has already been opened by 
OPEN statement or default open. 


i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
IMPLICIT OUTPUTS: 
LUBSV_DIRECT 1 
1 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 


LUBS$V_UNF ORMAT 

LUBSV_ASS_VAR_L set to the value of FLAG | 
LUBSA_ASSOC_VAR address of associated variable 
LUBS$L_REC_MAX set according to MAX_REC parameter passed 
LUBS$W_RBUF _SIZE set from REC_SIZ parameter passed 


i ROUTINE VALUE: 
i COMPLETION CODES: 


NONE | 
i SIDE EFFECTS: 

SIGNAL _STOPs: 
FORS_UNIALLOPE if the unit is already open ; 
FORS_DUPFILSPE if a define file has already been done on this unit 


FORS_INCRECTYP if the REC_SIZE parameter is out of range 
FORS_RECNUMOUT if the MAX_REC parameter is invalid. 
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BEGIN 


GLOBAL REGISTER 
CCB = K_CCB_REG : REF BLOCK C, BYTE); 
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CAL 
L_UNWIND_ACTION : VOLATILE, ! Unwind action code (FORSK_UNWIND{POP or NOP}) 
L_UNWIND DEPTH : VOLATILE, ! Number of additional frames to unwind if error 
A-ERR_ADR : VOLATILE, ! Indicates to error handler that 
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FORSDEF INE_FILE 1g. -Sep-1984 00:16:2 AX-11 Bliss-32 v4.0 Pp | 
1-004 > 1384 99: C age 63 


14-Sep- 731:4 FORRTL.SRC FORDEF INE. 3 231 (5) | 


-_—n 


081C 00000 COMMON_DEF FILE: 
WORD 


: He } 4 A_END_ADR : VOLATILE; ' there are no ERR and END= addresses ‘ 
; 280 1518 ENABLE ; 
; 381 0 FORSSERR_ENDHND (L_UNWIND_ACTION, A_ERR_ADR, A_END_ADR, L_UNWIND_DEPTH); : 
3 } § " ! pass info to error handler : 
3 aH ! : t Set up error handler conditions in case CB_PUSH bombs ‘ 
: 287 1226 L_UNUIND ACTION = FORSK,UNWINDNOP; | ; 
: 589 : ERR ADR ATEN "END_ADR = 0; | 
: 559 1355 $14 | : 
; 291 1250 i Get a LUB for this logical unit. ; 
: $36 } 33 i On return, CCB points to current control block. ; 
; 294 1238 _. FORSSCB_PUSH (.(.OLD_AP + K__UNIT), LUBSK_LUN MIN); : 
; $39 \$32 § | Unwind action (if an error occurs) is now to pop a LUB. ‘ 
: 298 1237 2. L_UNWIND_ACTION = FORSK_UNWINDPOP; | ; 
: $38 1238 2 !¢ 3 
; 300 1239 2! Check the LUB fur errors... : 
Peo igye ere 
; 308 124g ‘ IF .CCB CLUBSV_OPENED] THEN FORSSSIGNAL_STO (FORSK_UNIALROPE); | ; 
3 id ste § IF .CCB CLUBSV_DIRECT] THEN FORSSSIGNAL_STO (FORSK_DUPFILSPE); ! DEFINE FILE after DEFINE FILE | : 
i 307 1246 2 14 | 
; $05 ist 2 : Place appropriate information in the LUB from users parameters. | . 
: 310 1249 2 CCB CLUBSV_DIRECT) = 1; | ; 
; 311 1250 CCB CLUBSV-UNFORMAT] = "13 | : 
$ 315 1251 CCB CUBSY “ASS_VAR_L] = .FLAG; ! FLAG says longword assvar or not : 
; 6ST 1526 2 CCB CLUBSA “Ass0e VAR] = facta AP + K__ASS_VAR); ; 
; 3¢ \$37 2 CCB CLUBSLIREC_MAX] = .(:OLD_AP + K__MAX_REC); : 
3 $ 
3 316 1255 ; IF (.(.OLD_AP + K__REC_SIZ)*2 GTRU 65535) THEN FORSSSIGNAL_STO (FORSK_INCRECTYP); | ; 
; 318 1297 2 | CCB CLUBSW_RBUF_SIZE] = .(.OLD_AP + K__REC_S1Z)#2; | ; 
; $59 1623 $ Return the 1/0 system to its previous state. ; 
; 35) 1261 5 " FORSS$CB_POP (); ; 
:- Bes 1596 e RETURN; 3 
3; 324 12635 1 END; ! of routine COMMON_DEF_FILE : 
; Save R2,R3,R4,R11 ; 1160. ; 

$4 000000006 00 96 90002 HOVAB FORSSSIGNAL_SfO, R4 ; | 3 

5E C C2 00009 SUBL #i2, SP : 3 

04 AE D4 0000C L_UNWIND_DEPTH > 1208 : 


Co OT ererererererererererer Sr Sr are SiS Slee ee eral eer er er er er erererer er er Si Ser ei a ei ere er ao) 


wv on-nunMmN ~—Mo 
wn ANN OM maT w MMW Wmowoo 
~ NNO nm ™N mcucucuc mice 
eee ef =e - Cer erre ere 
@® 
ao Pete Fete Fe FS Fe FS Fe Fe Fa Fe FS FSS FS FSS SS FS FSS SHS SSS FS FSS SSS SSS FSS S Feta CR FR FR Pe Fe te 
@ 
a. 
- 
*. 
N 
ne 
7-@ 
™m™ e 
tw 
o2z 
oo 
Tu 
>w 
a 
Na 
moO w 
iS z oO oOo ~~ oO oa ae 
an or —- ~w za _ 
i nu et ” ” ” x= “ 
ca -a t iowa ‘ a ' 
| ~W Zz ww 2 I ad ao~ | 2 2 w 
| @- o <a oO <= < somr) <= = oO w 2 
/ =) _ te _ z 2 veveg z -_ _ i _ 
| be —- aca xe oF oO B2w~wv oOozA o a. os aa i | 
| —-a vw 22 mon =u ow * —mMma c w (=) ac w j 
‘= <—— MM See HD OWA MORN NOC - a =< KW a 
| xO @a i 33aaca wit As wou i omm “avo. c£OC mead | ~-A A | 
j <u fA0oOan2200 ce o 4 #8 HAE i> 4a) Aw~ | #ercroanaa eg] fs 4 } 
Sey aa zanonodaa @2—-—- aw awte ~~ acom o 2<a<aZz a oO | 
| (ou £© tt Pal: ox oOo ~~ wo Oowrvuo Cs oe tt be =) “ | 
| eaQ@3wKw~uioagcdtd a*®@BvY*s ww uw *s Macs ut A an 2aoacs “ke 
j z2az 2a tt MeZUR oucm Af *e0022ac2 a @ 
ww ss swWoO faDews 8 owe Ew St 8 TF Ee OK DwWWSD <« s ~ 
| cow (t @e— § LIO~O NHAEMR— INR NUOY MOTE MO Gwe~ ttt araAar~m 3 
| ws <€tuT Re edtatoewruti-BRBVeeeBu- OVWOmMeaectu “Os sia et sIVQ4Y SB 2 
Ms @ . 
| a+ oe «a Oo 4M wMN DUM a 2o92 .._, ” — 
| om) BSI sas I OT eC ET BO IYI UI IIS Ts eQouosrtrirrrild4 o 
Or Carr rrae ae rae ros POH UVM YUMMY Sr TAwHI>Or-O> SVN UY OD UF 
jIiIOO0 1jJ010M jJ0 JD<a Ode ZOOMWE UD IOYVWIOCODDDD_D_DO Sw ao] 
WTF VVVYVEETDVCVEVE M-VTE@MOAVMAVO FF aevOAvrZza -FFaAQAaaaatve c 
coco w 
on -*. 
oe 
te 
aa 
Woe 
wn ad 6 
oe _— N ~» wT 
xo 
eK ee TR VOT OSC OLE MO VOMMO UUW OV COON TOC OM TO ewe Th COW 
Om NII CIC OIN ST TT TT TWMNMUN OO OPR-P-P-F- PR. ODDDODOOOOOO ae 
pele e lel al el el el ol el olelelelelolol oleae olelolelolololelololololeolololelololololololo) 
SOOCCCOCOCCOOCCOOSCOOCOCOOCOCSCOSCOOSOCOSOO COCO COOOOCOOoOOoOoOOoCSoOSO of 
SOOoCSCCOOOOOCOOOCOCOCOCOOCC COCO OCOSOOCSCOOOSCOOOOOOoOoOO = 
Trt woosy TOF OOS WOM OCMWOOCOCO- MODOOCOwOOCOuwuwvrOooeaysr oO 
a a Sa ee ae aD a a a ee eee » 
o 
LV OMOW DOONAN — TN & OMIM EK MIN MO vooooowrwvun w 
~etVOOCO AC aNneOdt eOWNOO- OO Ft tT LOMNONONO <qaqacaqcconco S 
vw 
o o ad 
Too TF TOVUN Owooe o @owoowrw 4 « 
oon oo OCOOOu Oro o oounwnuwu oOo oO 
oOo o N oS “ 
Oo o o So ‘ 
Oo So 
o So 
[ oOo ee 
oO So 4 
Qww m ~ Nw STN NOC OOMsu —-@ oo wo @ 
oad ww mo woo owvoocdaaeo oat mw ~o @ 
a 
Oo c 
vo vewTouuw N So —- 
oo awouw im) oS bad 
“ oO > | 
“ oO °o 
o [=] cd 
S S 
S S 5 
a 
wm - ~» ~ a oa 
Oo Oo wn " — at 
a w ww 
i 
~ --O 
2 
oO wwnwo 
~ wooo 
— wn 
-—— 
w 7 
_ e 
— N N 
rr o - 
4 ” 
w 
=z a 
eee Cc 
“ —- 
w a wor 
a sce 
a ° mee 
i 4 « 
ot 
wr *. eters 


FORSDEF INE _FILE 
soon N= 


. 
eo 
- 
a 
. 
. 
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Name Bytes 
_FORSCODE 1 


ee ee ar eT SER VE LAL oP TARE LE SP ITRS EAL EPL TEU ET OORT SAEED DISTT CROSS I MSRC$:FORDEF INE/UPDATE=(ENH$:F ORDEF INE 


194 code + 0 data bytes 


Run Time: 00:09.3 
Elapsed Time: 00:38.8 
Lines/CPU Min: 8132 
Lexemes/CPU-Min: 38832 


Memor 
Compi 


ta 


Used: 105 pages 
tion Complete 


PSECT SUMMARY 


COMMAND QUALIFIERS 


SHR, 


1fcBeoctgte 99:16:28 YMett eLse4-32 v4.0 


Attributes 
EXE, 


LCL, 


REL, CON, PIC,ALIGN(2) 


PMENT CORPORATION 


AH-BT13A-SE 
ND PROPRIETARY 


VAX/VMS V4.0 
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